Separación de datos

Pruebas de No Linealidad Colones

Colones

General

nonlinearTseries::nonlinearityTest(actnetcrc, verbose = TRUE)
##       ** Teraesvirta's neural network test  **
##       Null hypothesis: Linearity in "mean" 
##       X-squared =  1.495836  df =  2  p-value =  0.473351 
## 
##       ** White neural network test  **
##       Null hypothesis: Linearity in "mean" 
##       X-squared =  1.313734  df =  2  p-value =  0.5184732 
## 
##       ** Keenan's one-degree test for nonlinearity  **
##       Null hypothesis: The time series follows some AR process
##       F-stat =  0.3879274  p-value =  0.5339872 
## 
##       ** McLeod-Li test  **
##       Null hypothesis: The time series follows some ARIMA process
##       Maximum p-value =  0 
## 
##       ** Tsay's Test for nonlinearity **
##       Null hypothesis: The time series follows some AR process
##       F-stat =  1.665705  p-value =  0.1302654 
## 
##       ** Likelihood ratio test for threshold nonlinearity **
##       Null hypothesis: The time series follows some AR process
##       Alternativce hypothesis: The time series follows some TAR process
##       X-squared =  6.02467  p-value =  0.3262153
## $Terasvirta
## 
##  Teraesvirta Neural Network Test
## 
## data:  ts(time.series)
## X-squared = 1.4958, df = 2, p-value = 0.4734
## 
## 
## $White
## 
##  White Neural Network Test
## 
## data:  ts(time.series)
## X-squared = 1.3137, df = 2, p-value = 0.5185
## 
## 
## $Keenan
## $Keenan$test.stat
## [1] 0.3879274
## 
## $Keenan$df1
## [1] 1
## 
## $Keenan$df2
## [1] 238
## 
## $Keenan$p.value
## [1] 0.5339872
## 
## $Keenan$order
## [1] 3
## 
## 
## $McLeodLi
## $McLeodLi$p.values
##  [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## 
## $Tsay
## $Tsay$test.stat
## [1] 1.665705
## 
## $Tsay$p.value
## [1] 0.1302654
## 
## $Tsay$order
## [1] 3
## 
## 
## $TarTest
## $TarTest$percentiles
## [1] 24.69136 75.30864
## 
## $TarTest$test.statistic
## [1] 6.02467
## 
## $TarTest$p.value
## [1] 0.3262153

Teraesvirta Neural Network Test

fNonlinear::tnnTest(actnetcrc, lag = 1, title = NULL, description = NULL)
## 
## Title:
##  Teraesvirta Neural Network Test
## 
## Test Results:
##   PARAMETER:
##     lag: 1
##     m|df: 2
##     t-lag-m|df: 243
##   STATISTIC:
##     Chi-squared: 1.4958
##     F: 0.741
##   P VALUE:
##     Chi-squared: 0.4734 
##     F: 0.4777 
## 
## Description:
##  Sun Jan  2 09:32:47 2022 by user:

Kennan tests for nonlineary

La hipótesis nula de que la serie de tiempo sigue algún proceso de AR.

Keenan.test(actnetcrc)
## $test.stat
## [1] 1.543471
## 
## $p.value
## [1] 0.2153245
## 
## $order
## [1] 3
Keenan.test(actnetcrc, order=1)
## $test.stat
## [1] 2.925783
## 
## $p.value
## [1] 0.08845647
## 
## $order
## [1] 1
Keenan.test(actnetcrc, order=2)
## $test.stat
## [1] 2.303251
## 
## $p.value
## [1] 0.1304197
## 
## $order
## [1] 2
Keenan.test(actnetcrc, order=3)
## $test.stat
## [1] 1.543471
## 
## $p.value
## [1] 0.2153245
## 
## $order
## [1] 3

BDS

bdsTest(actnetcrc)
## 
## Title:
##  BDS Test
## 
## Test Results:
##   PARAMETER:
##     Max Embedding Dimension: 3
##     eps[1]: 149998.2
##     eps[2]: 299996.4
##     eps[3]: 449994.6
##     eps[4]: 599992.8
##   STATISTIC:
##     eps[1] m=2: 452.6032
##     eps[1] m=3: 872.458
##     eps[2] m=2: 124.0371
##     eps[2] m=3: 165.3509
##     eps[3] m=2: 61.6966
##     eps[3] m=3: 66.5555
##     eps[4] m=2: 50.4794
##     eps[4] m=3: 50.3626
##   P VALUE:
##     eps[1] m=2: < 2.2e-16 
##     eps[1] m=3: < 2.2e-16 
##     eps[2] m=2: < 2.2e-16 
##     eps[2] m=3: < 2.2e-16 
##     eps[3] m=2: < 2.2e-16 
##     eps[3] m=3: < 2.2e-16 
##     eps[4] m=2: < 2.2e-16 
##     eps[4] m=3: < 2.2e-16 
## 
## Description:
##  Sun Jan  2 09:32:47 2022 by user:

Thresold Non Linearity

lag1.plot(actnetcrc, max.lag=12)

thr.test(actnetcrc)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  1 1 
## F-ratio and p-value:  1.137518 0.3226488
thr.test(actnetcrc,p=2,d=1)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  2 1 
## F-ratio and p-value:  0.56245 0.6403908
thr.test(actnetcrc,p=2,d=2)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  2 2 
## F-ratio and p-value:  0.5674339 0.6370808
thr.test(actnetcrc,p=3,d=1)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  3 1 
## F-ratio and p-value:  0.3389735 0.8514497
thr.test(actnetcrc,p=3,d=2)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  3 2 
## F-ratio and p-value:  0.3073914 0.8728151
thr.test(actnetcrc,p=3,d=3)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  3 3 
## F-ratio and p-value:  0.1618974 0.9573748

Dolares

General

nonlinearTseries::nonlinearityTest(actnetusd, verbose = TRUE)
##       ** Teraesvirta's neural network test  **
##       Null hypothesis: Linearity in "mean" 
##       X-squared =  0.4947052  df =  2  p-value =  0.7808653 
## 
##       ** White neural network test  **
##       Null hypothesis: Linearity in "mean" 
##       X-squared =  0.7537214  df =  2  p-value =  0.6860116 
## 
##       ** Keenan's one-degree test for nonlinearity  **
##       Null hypothesis: The time series follows some AR process
##       F-stat =  0.09429519  p-value =  0.7590502 
## 
##       ** McLeod-Li test  **
##       Null hypothesis: The time series follows some ARIMA process
##       Maximum p-value =  0 
## 
##       ** Tsay's Test for nonlinearity **
##       Null hypothesis: The time series follows some AR process
##       F-stat =  0.09895123  p-value =  0.7533629 
## 
##       ** Likelihood ratio test for threshold nonlinearity **
##       Null hypothesis: The time series follows some AR process
##       Alternativce hypothesis: The time series follows some TAR process
##       X-squared =  3.211571  p-value =  0.3061738
## $Terasvirta
## 
##  Teraesvirta Neural Network Test
## 
## data:  ts(time.series)
## X-squared = 0.49471, df = 2, p-value = 0.7809
## 
## 
## $White
## 
##  White Neural Network Test
## 
## data:  ts(time.series)
## X-squared = 0.75372, df = 2, p-value = 0.686
## 
## 
## $Keenan
## $Keenan$test.stat
## [1] 0.09429519
## 
## $Keenan$df1
## [1] 1
## 
## $Keenan$df2
## [1] 242
## 
## $Keenan$p.value
## [1] 0.7590502
## 
## $Keenan$order
## [1] 1
## 
## 
## $McLeodLi
## $McLeodLi$p.values
##  [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## 
## 
## $Tsay
## $Tsay$test.stat
## [1] 0.09895123
## 
## $Tsay$p.value
## [1] 0.7533629
## 
## $Tsay$order
## [1] 1
## 
## 
## $TarTest
## $TarTest$percentiles
## [1] 24.89796 75.10204
## 
## $TarTest$test.statistic
## [1] 3.211571
## 
## $TarTest$p.value
## [1] 0.3061738

Teraesvirta Neural Network Test

fNonlinear::tnnTest(actnetusd, lag = 1, title = NULL, description = NULL)
## 
## Title:
##  Teraesvirta Neural Network Test
## 
## Test Results:
##   PARAMETER:
##     lag: 1
##     m|df: 2
##     t-lag-m|df: 243
##   STATISTIC:
##     Chi-squared: 0.4947
##     F: 0.2446
##   P VALUE:
##     Chi-squared: 0.7809 
##     F: 0.7832 
## 
## Description:
##  Sun Jan  2 09:32:52 2022 by user:

Kennan tests for nonlineary

La hipótesis nula de que la serie de tiempo sigue algún proceso de AR.

Keenan.test(actnetusd)
## $test.stat
## [1] 0.946225
## 
## $p.value
## [1] 0.3316533
## 
## $order
## [1] 1
Keenan.test(actnetusd, order=1)
## $test.stat
## [1] 0.946225
## 
## $p.value
## [1] 0.3316533
## 
## $order
## [1] 1
Keenan.test(actnetusd, order=2)
## $test.stat
## [1] 0.7711585
## 
## $p.value
## [1] 0.3807372
## 
## $order
## [1] 2
Keenan.test(actnetusd, order=3)
## $test.stat
## [1] 0.4338976
## 
## $p.value
## [1] 0.5107194
## 
## $order
## [1] 3

BDS

bdsTest(actnetusd)
## 
## Title:
##  BDS Test
## 
## Test Results:
##   PARAMETER:
##     Max Embedding Dimension: 3
##     eps[1]: 222.772
##     eps[2]: 445.544
##     eps[3]: 668.316
##     eps[4]: 891.088
##   STATISTIC:
##     eps[1] m=2: 493.7605
##     eps[1] m=3: 932.8523
##     eps[2] m=2: 128.601
##     eps[2] m=3: 168.0983
##     eps[3] m=2: 63.0738
##     eps[3] m=3: 67.5475
##     eps[4] m=2: 51.3731
##     eps[4] m=3: 50.975
##   P VALUE:
##     eps[1] m=2: < 2.2e-16 
##     eps[1] m=3: < 2.2e-16 
##     eps[2] m=2: < 2.2e-16 
##     eps[2] m=3: < 2.2e-16 
##     eps[3] m=2: < 2.2e-16 
##     eps[3] m=3: < 2.2e-16 
##     eps[4] m=2: < 2.2e-16 
##     eps[4] m=3: < 2.2e-16 
## 
## Description:
##  Sun Jan  2 09:32:52 2022 by user:

Thresold Non Linearity

lag1.plot(actnetusd, max.lag=12)

thr.test(actnetusd)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  1 1 
## F-ratio and p-value:  0.3290875 0.7199632
thr.test(actnetusd,p=2,d=1)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  2 1 
## F-ratio and p-value:  0.270361 0.8467241
thr.test(actnetusd,p=2,d=2)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  2 2 
## F-ratio and p-value:  0.2056243 0.8924247
thr.test(actnetusd,p=3,d=1)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  3 1 
## F-ratio and p-value:  0.1718436 0.9526018
thr.test(actnetusd,p=3,d=2)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  3 2 
## F-ratio and p-value:  0.1352353 0.969191
thr.test(actnetusd,p=3,d=3)
## SETAR model is entertained 
## Threshold nonlinearity test for (p,d):  3 3 
## F-ratio and p-value:  0.2117609 0.931694

Modelos No Lineales

Colones

TAR

# m orden
pm <- 1:3

mod.list.tar<-list()
AIC.best.list<-list()

AICM = NULL
model.best <- list(d=0, p1=0, p2=0)
AIC.best = 2888

for(l in pm){
  for(j in pm){
    for(i in pm){
      set.seed(777)
      model.tar.s = tar(sactnetcrc_train,p1=j,p2=i,d=l)
      mod.list.tar[[paste(j,i,l,sep="-")]]<-model.tar.s$AIC
      #print(paste(j,i,l,sep="-"))    
      
      if (model.tar.s$AIC < AIC.best) {
            AIC.best = model.tar.s$AIC
            AIC.best.list[[paste(j,i,l,sep="-")]]<-AIC.best
            #print(AIC.best)
            model.best$d = l
            model.best$p1 = model.tar.s$p1
            model.best$p2 = model.tar.s$p2 
            print(paste(model.tar.s$p1,model.tar.s$p2,l,sep="-")) }
    }
  }
}

# AICTar<-bind_rows(mod.list.tar,.id = "Ordene-delay")%>%
#   arrange(`1`)
# 
# knitr::kable(head(AICTar,20))

AICTarBest<-bind_rows(AIC.best.list,.id = "Ordene-delay")%>%
  arrange(`1`)

knitr::kable(head(AICTarBest,20))
mod.tar1<-TSA::tar(sactnetcrc_train,p1=2,p2=3,d=1)  
mod.tar2<-TSA::tar(sactnetcrc_train,p1=3,p2=1,d=1)  
mod.tar3<-TSA::tar(sactnetcrc_train,p1=3,p2=2,d=1)  

mod.tar1$thd
##          
## 778351.5
mod.tar2$thd
##          
## 634783.1
mod.tar3$thd
##          
## 778351.5
mod.tar1$qr1$coefficients
## intercept-sactnetcrc_train      lag1-sactnetcrc_train 
##               1.133239e+04               8.135618e-01 
##      lag2-sactnetcrc_train 
##               1.841392e-01
mod.tar2$qr1$coefficients
## intercept-sactnetcrc_train      lag1-sactnetcrc_train 
##              21868.4352666                  0.7499834 
##      lag2-sactnetcrc_train      lag3-sactnetcrc_train 
##                 -0.3430847                  0.5609114
mod.tar3$qr1$coefficients
## intercept-sactnetcrc_train      lag1-sactnetcrc_train 
##              4895.78533430                 0.78566926 
##      lag2-sactnetcrc_train      lag3-sactnetcrc_train 
##                -0.07458825                 0.29804232
mod.tar1$qr2$coefficients
## intercept-sactnetcrc_train      lag1-sactnetcrc_train 
##              -2.856838e+05               2.250800e+00 
##      lag2-sactnetcrc_train 
##              -1.029562e+00
mod.tar2$qr2$coefficients
## intercept-sactnetcrc_train      lag1-sactnetcrc_train 
##               9.180235e+04               8.826022e-01
mod.tar3$qr2$coefficients
## intercept-sactnetcrc_train      lag1-sactnetcrc_train 
##              -2.856838e+05               2.250800e+00 
##      lag2-sactnetcrc_train 
##              -1.029562e+00
cbind(
Modelo=c("p1=2,p2=3,d=1",
         "p1=3,p2=1,d=1",
         "p1=3,p2=2,d=1"),
AIC=c(mod.tar1$AIC,
mod.tar2$AIC,
mod.tar3$AIC))%>%
  knitr::kable()
Modelo AIC
1 p1=2,p2=3,d=1 2880
1 p1=3,p2=1,d=1 2878
1 p1=3,p2=2,d=1 2873 
#tsdiag(mod.tar1)
tsdiag(mod.tar2)

#tsdiag(mod.tar3)


checkresiduals(ts(mod.tar1$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

checkresiduals(ts(mod.tar2$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

checkresiduals(ts(mod.tar3$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

prontar1<- ts(as.vector(predict(mod.tar1,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar2<- ts(as.vector(predict(mod.tar2,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar3<- ts(as.vector(predict(mod.tar3,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)

fit1<-ts(as.vector(mod.tar1$y)-as.vector(mod.tar1$residuals),start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1$y) - as.vector(mod.tar1$residuals): longer object
## length is not a multiple of shorter object length
fit2<-ts(sactnetcrc_train-mod.tar2$residuals,start =c(2011,1),frequency = 12)
## Warning in `-.default`(sactnetcrc_train, mod.tar2$residuals): longer object
## length is not a multiple of shorter object length
fit3<-ts(sactnetcrc_train-mod.tar3$residuals,start =c(2011,1),frequency = 12)
## Warning in `-.default`(sactnetcrc_train, mod.tar3$residuals): longer object
## length is not a multiple of shorter object length
autoplot(sactnetcrc_train)+
  autolayer(fit1)+
  autolayer(fit2)+
  autolayer(fit3)+
  theme_bw()

Metrics::rmse(sactnetcrc_test, prontar1)
## [1] 294161.5
Metrics::rmse(sactnetcrc_test, prontar2)
## [1] 139594.6
Metrics::rmse(sactnetcrc_test, prontar3)
## [1] 257694.2
autoplot(sactnetcrc_test)+
  autolayer(prontar1)+
  autolayer(prontar2)+
  autolayer(prontar3)+
  theme_bw()+
  scale_y_continuous(limits = c(500000,1400000))

SETAR

Thus the threshold delay, the number of lags in each regime and the threshold value are computed.

Setar1 <-
  selectSETAR(
    sactnetcrc_train, 
    include = c("const", "trend","none", "both"),
    m = 3,
    thDelay = seq(1, 2, by = 1),
    nthresh = 2,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )

Setar2 <-
  selectSETAR(
    sactnetcrc_train,
    m = 3,
    d=2,
    thDelay = seq(1, 2, by = 1),
    nthresh = 2,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )

Setar3 <-
  selectSETAR(
    sactnetcrc_train,
    m = 3,
    thDelay = seq(0, 2, by = 1),
    nthresh = 1,
    d = 1,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )

Setar4 <-
  selectSETAR(
    sactnetcrc_train,
    m = 3,
    thDelay = seq(0, 2, by = 1),
    nthresh = 1,
    d = 2,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )


Setar1$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)


Setar2$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)

Setar3$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)

Setar4$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)
modeloas1 <-
  setar(
    sactnetcrc_train,
    m = 3,
    mL = 3,
    mH = 1,
    d=1,
    nthresh = 1,
    thDelay = 2,
    type = "level"
  )
## 
##  1 T: Trim not respected:  0.8632479 0.1367521 from th: 770561.5
## Warning: Possible unit root in the low regime. Roots are: 0.9958 1.4296 1.4296
## Raiz Unitaria
summary(modeloas1) #residuals variance = 0.005525,  AIC = -632, MAPE = 0.4352%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##      const.L       phiL.1       phiL.2       phiL.3 
## 6788.2145658    0.8298233   -0.3141401    0.4914032 
## 
## High regime:
##      const.H       phiH.1 
## 6.258059e+04 9.301118e-01 
## 
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (0)X(t-1)+ (1)X(t-2)
## -Value: 730318
## Proportion of points in low regime: 74.36%    High regime: 25.64% 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -153164.6  -31930.4   -1978.2   28529.5  169203.7 
## 
## Fit:
## residuals variance = 2.669e+09,  AIC = 2619, MAPE = 6.397%
## 
## Coefficient(s):
## 
##            Estimate  Std. Error  t value  Pr(>|t|)    
## const.L  6.7882e+03  2.6284e+04   0.2583   0.79667    
## phiL.1   8.2982e-01  1.2260e-01   6.7686 5.923e-10 ***
## phiL.2  -3.1414e-01  1.6136e-01  -1.9469   0.05401 .  
## phiL.3   4.9140e-01  1.1942e-01   4.1150 7.347e-05 ***
## const.H  6.2581e+04  5.6979e+04   1.0983   0.27438    
## phiH.1   9.3011e-01  6.9313e-02  13.4190 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (0) X(t) + (0) X(t-1)+ (1) X(t-2)
## 
## Value: 730318
# plot(modeloas1)
checkresiduals(ts(modeloas1$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

modeloas2 <-
  setar(
    sactnetcrc_train,
    m = 3,
    mL = 2,
    mH = 3,
    d=2,
    nthresh = 1,
    thDelay = 2,
    type = "level"
  )
## 
##  1 T: Trim not respected:  0.8508772 0.1491228 from th: 763482.7
##  1 T: Trim not respected:  0.8596491 0.1403509 from th: 765999.6
##  1 T: Trim not respected:  0.877193 0.122807 from th: 768336.6
## Warning: Possible unit root in the high regime. Roots are: 0.8544 1.0679 1.0679
## Warning: Possible unit root in the low regime. Roots are: 0.9985 1.9337
## Raiz Unitaria
summary(modeloas2) # residuals variance = 0.005857,  AIC = -635, MAPE = 0.4584%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##      const.L       phiL.1       phiL.2 
## 1.596903e+04 4.843835e-01 5.179294e-01 
## 
## High regime:
##       const.H        phiH.1        phiH.2        phiH.3 
## -3.459287e+05  5.219453e-01 -1.177826e-01  1.026279e+00 
## 
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (0)X(t-1)+ (1)X(t-2)
## -Value: 743290
## Proportion of points in low regime: 79.82%    High regime: 20.18% 
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -173908  -41385   -2497   44119  191478 
## 
## Fit:
## residuals variance = 4.159e+09,  AIC = 2674, MAPE = 8.046%
## 
## Coefficient(s):
## 
##            Estimate  Std. Error  t value  Pr(>|t|)    
## const.L  1.5969e+04  2.9655e+04   0.5385   0.59129    
## phiL.1   4.8438e-01  1.0049e-01   4.8202 4.503e-06 ***
## phiL.2   5.1793e-01  1.0345e-01   5.0064 2.059e-06 ***
## const.H -3.4593e+05  2.2883e+05  -1.5117   0.13340    
## phiH.1   5.2195e-01  2.0755e-01   2.5147   0.01332 *  
## phiH.2  -1.1778e-01  2.0588e-01  -0.5721   0.56840    
## phiH.3   1.0263e+00  3.9780e-01   2.5799   0.01117 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (0) X(t) + (0) X(t-1)+ (1) X(t-2)
## 
## Value: 743290
# plot(modeloas2)
checkresiduals(ts(modeloas2$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

modeloas3 <-
  setar(
    sactnetcrc_train,
    m = 3,
    mL = 3,
    mH = 2,
    d=1,
    nthresh = 1,
    thDelay = 0,
    type = "level"
  )
## Warning: Possible unit root in the high regime. Roots are: 0.7777 1.5287
## Warning: Possible unit root in the low regime. Roots are: 0.9837 1.736 1.736
## Raiz Unitaria
summary(modeloas3) # residuals variance = 0.006319,  AIC = -621, MAPE = 0.4621%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##       const.L        phiL.1        phiL.2        phiL.3 
## -3220.1735591     0.8068262    -0.1186698     0.3373163 
## 
## High regime:
##       const.H        phiH.1        phiH.2 
## -1.530389e+05  1.939965e+00 -8.411220e-01 
## 
## Threshold:
## -Variable: Z(t) = + (1) X(t)+ (0)X(t-1)+ (0)X(t-2)
## -Value: 766324
## Proportion of points in low regime: 82.91%    High regime: 17.09% 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -195426.8  -26217.0   -6775.5   30310.5  159633.0 
## 
## Fit:
## residuals variance = 2.394e+09,  AIC = 2608, MAPE = 6.077%
## 
## Coefficient(s):
## 
##            Estimate  Std. Error  t value  Pr(>|t|)    
## const.L -3.2202e+03  2.3624e+04  -0.1363 0.8918211    
## phiL.1   8.0683e-01  1.0141e-01   7.9561 1.500e-12 ***
## phiL.2  -1.1867e-01  1.3459e-01  -0.8817 0.3798108    
## phiL.3   3.3732e-01  1.0782e-01   3.1284 0.0022358 ** 
## const.H -1.5304e+05  8.2622e+04  -1.8523 0.0665944 .  
## phiH.1   1.9400e+00  2.5176e-01   7.7058 5.452e-12 ***
## phiH.2  -8.4112e-01  2.2778e-01  -3.6926 0.0003434 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (1) X(t) + (0) X(t-1)+ (0) X(t-2)
## 
## Value: 766324
# plot(modeloas3)
checkresiduals(ts(modeloas3$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

modeloas4 <-
  setar(
    sactnetcrc_train,
    m = 3,
    mL = 1,
    mH = 2,
    d=2,
    nthresh = 1,
    thDelay = 0,
    type = "level"
  )
summary(modeloas4) # residuals variance = 0.006319,  AIC = -621, MAPE = 0.4621%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##       const.L        phiL.1 
## 497047.101814     -0.245272 
## 
## High regime:
##      const.H       phiH.1       phiH.2 
## 4.872806e+04 6.017097e-01 3.500140e-01 
## 
## Threshold:
## -Variable: Z(t) = + (1) X(t)+ (0)X(t-1)+ (0)X(t-2)
## -Value: 438446
## Proportion of points in low regime: 17.54%    High regime: 82.46% 
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -161045  -39211   -5795   36633  192910 
## 
## Fit:
## residuals variance = 4.642e+09,  AIC = 2683, MAPE = 7.938%
## 
## Coefficient(s):
## 
##            Estimate  Std. Error  t value  Pr(>|t|)    
## const.L  4.9705e+05  2.3095e+05   2.1522 0.0334753 *  
## phiL.1  -2.4527e-01  5.9323e-01  -0.4135 0.6800454    
## const.H  4.8728e+04  3.9998e+04   1.2183 0.2256210    
## phiH.1   6.0171e-01  9.2488e-02   6.5058 2.091e-09 ***
## phiH.2   3.5001e-01  9.8458e-02   3.5550 0.0005498 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (1) X(t) + (0) X(t-1)+ (0) X(t-2)
## 
## Value: 438446
# plot(modeloas4)
checkresiduals(ts(modeloas4$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

AIC(modeloas1)
## [1] 2618.596
AIC(modeloas2)
## [1] 2673.823
AIC(modeloas3)
## [1] 2607.529
AIC(modeloas4)
## [1] 2683.013
pronsetar1<- predict(modeloas1, n.ahead = 7)
pronsetar2<- predict(modeloas2, n.ahead = 7)
pronsetar3<- predict(modeloas3, n.ahead = 7)
pronsetar4<- predict(modeloas4, n.ahead = 7)

fit1<-ts(modeloas1$fitted.values,start =c(2011,1),frequency = 12)
fit2<-ts(modeloas2$fitted.values,start =c(2011,1),frequency = 12)
fit3<-ts(modeloas3$fitted.values,start =c(2011,1),frequency = 12)
fit4<-ts(modeloas4$fitted.values,start =c(2011,1),frequency = 12)

autoplot(sactnetcrc_train)+
  autolayer(fit1)+
  autolayer(fit2)+
  autolayer(fit3)+
  autolayer(fit4)+
  theme_bw()

data.frame(
Modelo= c(
  "1) m = 3,mL = 3,mH = 1, d=1",
  "2) m = 3,mL = 2,mH = 3, d=2",
  "3) m = 3,mL = 3,mH = 2, d=1",
  "4) m = 3,mL = 1,mH = 2, d=2"
),
RMSE=c(
  Metrics::rmse(sactnetcrc_test, pronsetar1),
  Metrics::rmse(sactnetcrc_test, pronsetar2),
  Metrics::rmse(sactnetcrc_test, pronsetar3),
  Metrics::rmse(sactnetcrc_test, pronsetar4)))%>%
  arrange(RMSE)%>%
  knitr::kable()
Modelo RMSE
4) m = 3,mL = 1,mH = 2, d=2 80934.83
1) m = 3,mL = 3,mH = 1, d=1 97545.73
2) m = 3,mL = 2,mH = 3, d=2 245685.71
3) m = 3,mL = 3,mH = 2, d=1 313915.21 
autoplot(sactnetcrc_test)+
  autolayer(pronsetar1)+
  autolayer(pronsetar2)+
  autolayer(pronsetar3)+
  autolayer(pronsetar4)+
  theme_bw()+
  scale_y_continuous(limits = c(500000,1400000))

Metricas Generales

Metrics::rmse(sactnetcrc_test,(prontar2))
Metrics::rmse(sactnetcrc_test, (pronsetar4))

autoplot(sactnetcrc_test)+
  autolayer(prontar2)+
  autolayer(pronsetar4)+
  theme_bw()+
  scale_y_continuous(limits = c(500000,1400000))

Dolares

TAR

# m orden
pm <- 1:4

mod.list.tar<-list()
AIC.best.list<-list()

AICM = NULL
model.best <- list(d=0, p1=0, p2=0)
AIC.best = 10000

for(l in pm){
  for(j in pm){
    for(i in pm){
      set.seed(777)
      model.tar.s = tar(sactnetusd_train,p1=j,p2=i,d=l)
      mod.list.tar[[paste(j,i,l,sep="-")]]<-model.tar.s$AIC
      print(paste("Modelo:",j,i,l,sep="-"))    
      
      if (model.tar.s$AIC < AIC.best) {
            AIC.best = model.tar.s$AIC
            AIC.best.list[[paste(j,i,l,sep="-")]]<-AIC.best
            #print("Modelo:",j,i,l,"AIC",AIC.best)
            model.best$d = l
            model.best$p1 = model.tar.s$p1
            model.best$p2 = model.tar.s$p2 
            print(paste(model.tar.s$p1,model.tar.s$p2,l,sep="-")) }
    }
  }
}

# AICTar<-bind_rows(mod.list.tar,.id = "Ordene-delay")%>%
#   arrange(`1`)
# 
# knitr::kable(head(AICTar,20))

AICTarBest<-bind_rows(AIC.best.list,.id = "Ordene-delay")%>%
  arrange(`1`)

knitr::kable(head(AICTarBest,20))
mod.tar1.usd<-TSA::tar(sactnetusd_train,p1=3,p2=4,d=1)  
mod.tar2.usd<-TSA::tar(sactnetusd_train,p1=1,p2=2,d=1)  
mod.tar3.usd<-TSA::tar(sactnetusd_train,p1=1,p2=3,d=1)  

mod.tar1.usd$thd
##          
## 622.0209
mod.tar2.usd$thd
##          
## 670.8907
mod.tar3.usd$thd
##          
## 691.3097
mod.tar1.usd$qr1$coefficients
## intercept-sactnetusd_train      lag1-sactnetusd_train 
##                181.4332347                  1.6151098 
##      lag2-sactnetusd_train      lag3-sactnetusd_train 
##                 -1.3676001                  0.4599062
mod.tar2.usd$qr1$coefficients
## intercept-sactnetusd_train      lag1-sactnetusd_train 
##                166.0529509                  0.7379237
mod.tar3.usd$qr1$coefficients
## intercept-sactnetusd_train      lag1-sactnetusd_train 
##                132.9783554                  0.7962717
mod.tar1.usd$qr2$coefficients
## intercept-sactnetusd_train      lag1-sactnetusd_train 
##                 65.0189187                  0.9439411
mod.tar2.usd$qr2$coefficients
## intercept-sactnetusd_train      lag1-sactnetusd_train 
##                 83.4616216                  0.9278156
mod.tar3.usd$qr2$coefficients
## intercept-sactnetusd_train      lag1-sactnetusd_train 
##                108.7318363                  0.9060299
data.frame(
Modelo=c("p1=3,p2=4,d=1",
         "p1=1,p2=2,d=1",
         "p1=1,p2=3,d=1"),
AIC=c(mod.tar1.usd$AIC,
mod.tar2.usd$AIC,
mod.tar3.usd$AIC))%>%
  arrange(AIC)%>%
  knitr::kable()
Modelo AIC
p1=3,p2=4,d=1 1323
p1=1,p2=3,d=1 1346
p1=1,p2=2,d=1 1357 
tsdiag(mod.tar1.usd)

tsdiag(mod.tar2.usd)

tsdiag(mod.tar3.usd)

checkresiduals(ts(mod.tar1.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

checkresiduals(ts(mod.tar2.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

checkresiduals(ts(mod.tar3.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

prontar1.usd<- ts(as.vector(predict(mod.tar1.usd,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar2.usd<- ts(as.vector(predict(mod.tar2.usd,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)
prontar3.usd<- ts(as.vector(predict(mod.tar3.usd,n.ahead=7,n.sim=1000)$fit),start=c(2021,1),frequency = 12)

fit1.usd<-ts(as.vector(mod.tar1.usd$y)-as.vector(mod.tar1.usd$residuals),start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1.usd$y) - as.vector(mod.tar1.usd$residuals): longer
## object length is not a multiple of shorter object length
fit2.usd<-ts(as.vector(mod.tar1.usd$y)-mod.tar2.usd$residuals,start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1.usd$y) - mod.tar2.usd$residuals: longer object
## length is not a multiple of shorter object length
fit3.usd<-ts(as.vector(mod.tar1.usd$y)-mod.tar3.usd$residuals,start =c(2011,1),frequency = 12)
## Warning in as.vector(mod.tar1.usd$y) - mod.tar3.usd$residuals: longer object
## length is not a multiple of shorter object length
autoplot(sactnetusd_train)+
  autolayer(fit1.usd)+
  autolayer(fit2.usd)+
  autolayer(fit3.usd)+
  theme_bw()

data.frame(
Modelo=c("p1=3,p2=4,d=1",
         "p1=1,p2=2,d=1",
         "p1=1,p2=3,d=1"),
RMSE=c(
  Metrics::rmse(sactnetusd_test, prontar1.usd),
  Metrics::rmse(sactnetusd_test, prontar2.usd),
  Metrics::rmse(sactnetusd_test, prontar3.usd)))%>%
  arrange(RMSE)%>%
  knitr::kable()
Modelo RMSE
p1=3,p2=4,d=1 329.1884
p1=1,p2=2,d=1 351.2767
p1=1,p2=3,d=1 371.4562 
autoplot(sactnetusd_test)+
  autolayer(prontar1.usd)+
  autolayer(prontar2.usd)+
  autolayer(prontar3.usd)+
  theme_bw()

SETAR

Thus the threshold delay, the number of lags in each regime and the threshold value are computed.

Setar1.usd <-
  selectSETAR(
    sactnetusd_train, 
    include = c("const", "trend","none", "both"),
    m = 4,
    thDelay = seq(0, 3, by = 1),
    nthresh = 3,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )

Setar2.usd <-
  selectSETAR(
    sactnetusd_train,
    m = 4,
    d=2,
    thDelay = seq(0, 3 by = 1),
    nthresh = 3,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )

Setar3.usd <-
  selectSETAR(
    sactnetusd_train,
    m = 4,
    thDelay = seq(0, 3, by = 1),
    nthresh = 3,
    d = 1,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )

Setar4.usd <-
  selectSETAR(
    sactnetusd_train,
    m = 4,
    thDelay = seq(0, 3, by = 1),
    nthresh = 3,
    d = 2,
    criterion = "AIC",
    type = "level",
    plot = T,
    trace = T
  )


Setar1.usd$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)


Setar2.usd$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)

Setar3.usd$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)

Setar4.usd$allTh%>%
  as.data.frame()%>%
  arrange(AIC,thDelay,mL,mH)%>%
  head(5)
modeloas1.usd <-
  setar(
    sactnetusd_train,
    mL = 1,
    mH = 1,
    d=1,
    nthresh = 1,
    thDelay = 1,
    type = "level"
  )
## 
##  1 T: Trim not respected:  0.8559322 0.1440678 from th: 1212.776
## Warning: Possible unit root in the high regime. Roots are: 0.926
## Warning: Possible unit root in the low regime. Roots are: 0.9973
## Raiz Unitaria
summary(modeloas1.usd) #residuals variance = 0.005525,  AIC = -632, MAPE = 0.4352%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##   const.L    phiL.1 
## 14.375566  1.002708 
## 
## High regime:
##     const.H      phiH.1 
## -139.242572    1.079965 
## 
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)
## -Value: 1203
## Proportion of points in low regime: 81.36%    High regime: 18.64% 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -143.9335  -53.2829   -5.4996   50.1964  240.7517 
## 
## Fit:
## residuals variance = 5265,  AIC = 1038, MAPE = 6.015%
## 
## Coefficient(s):
## 
##            Estimate  Std. Error  t value  Pr(>|t|)    
## const.L   14.375566   33.188627   0.4331    0.6657    
## phiL.1     1.002708    0.034585  28.9927 < 2.2e-16 ***
## const.H -139.242572  155.823087  -0.8936    0.3734    
## phiH.1     1.079965    0.121916   8.8583 1.111e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
## 
## Value: 1203
# plot(modeloas1)
checkresiduals(ts(modeloas1.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

modeloas2.usd <-
  setar(
    sactnetusd_train,
    mL = 3,
    mH = 1,
    d=2,
    nthresh = 1,
    thDelay = 1,
    type = "level"
  )
## 
##  1 T: Trim not respected:  0.8596491 0.1403509 from th: 1212.381
## Warning: Possible unit root in the low regime. Roots are: 0.9303 1.143 0.9303
## Raiz Unitaria
summary(modeloas2.usd) # residuals variance = 0.005857,  AIC = -635, MAPE = 0.4584%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##     const.L      phiL.1      phiL.2      phiL.3 
## 858.2495437   0.5731090   0.1113798  -1.0108432 
## 
## High regime:
##     const.H      phiH.1 
## 258.7562047   0.7787606 
## 
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)+ (0)X(t-2)
## -Value: 785.8
## Proportion of points in low regime: 22.81%    High regime: 77.19% 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -267.8547  -64.4825   -8.4419   55.1728  308.2301 
## 
## Fit:
## residuals variance = 8762,  AIC = 1103, MAPE = 7.549%
## 
## Coefficient(s):
## 
##           Estimate  Std. Error  t value  Pr(>|t|)    
## const.L 858.249544  248.319565   3.4562 0.0007705 ***
## phiL.1    0.573109    0.195945   2.9249 0.0041589 ** 
## phiL.2    0.111380    0.308654   0.3609 0.7188742    
## phiL.3   -1.010843    0.297348  -3.3995 0.0009310 ***
## const.H 258.756205   76.771445   3.3705 0.0010249 ** 
## phiH.1    0.778761    0.068832  11.3140 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)+ (0) X(t-2)
## 
## Value: 785.8
# plot(modeloas2)
checkresiduals(ts(modeloas2.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

modeloas3.usd <-
  setar(
    sactnetusd_train,
    mL = 1,
    mH = 1,
    d=1,
    nthresh = 1,
    thDelay = 1,
    type = "level"
  )
## 
##  1 T: Trim not respected:  0.8559322 0.1440678 from th: 1212.776
## Warning: Possible unit root in the high regime. Roots are: 0.926

## Warning: Possible unit root in the low regime. Roots are: 0.9973
## Raiz Unitaria
summary(modeloas3.usd) # residuals variance = 0.006319,  AIC = -621, MAPE = 0.4621%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##   const.L    phiL.1 
## 14.375566  1.002708 
## 
## High regime:
##     const.H      phiH.1 
## -139.242572    1.079965 
## 
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)
## -Value: 1203
## Proportion of points in low regime: 81.36%    High regime: 18.64% 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -143.9335  -53.2829   -5.4996   50.1964  240.7517 
## 
## Fit:
## residuals variance = 5265,  AIC = 1038, MAPE = 6.015%
## 
## Coefficient(s):
## 
##            Estimate  Std. Error  t value  Pr(>|t|)    
## const.L   14.375566   33.188627   0.4331    0.6657    
## phiL.1     1.002708    0.034585  28.9927 < 2.2e-16 ***
## const.H -139.242572  155.823087  -0.8936    0.3734    
## phiH.1     1.079965    0.121916   8.8583 1.111e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
## 
## Value: 1203
# plot(modeloas3)
checkresiduals(ts(modeloas3.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

modeloas4.usd <-
  setar(
    sactnetusd_train,
    m = 3,
    mL = 1,
    mH = 2,
    d=2,
    nthresh = 1,
    thDelay = 0,
    type = "level"
  )
## Warning: Possible unit root in the high regime. Roots are: 0.8301 6.3855
## Warning: Possible unit root in the low regime. Roots are: 0.9875
summary(modeloas4.usd) # residuals variance = 0.006319,  AIC = -621, MAPE = 0.4621%
## 
## Non linear autoregressive model
## 
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
##   const.L    phiL.1 
## 22.905069  1.012612 
## 
## High regime:
##      const.H       phiH.1       phiH.2 
## -351.2749796    1.0481121    0.1886645 
## 
## Threshold:
## -Variable: Z(t) = + (1) X(t)+ (0)X(t-1)+ (0)X(t-2)
## -Value: 1193
## Proportion of points in low regime: 78.95%    High regime: 21.05% 
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -234.1334  -76.6856    2.1224   61.6316  277.0180 
## 
## Fit:
## residuals variance = 9172,  AIC = 1107, MAPE = 8.311%
## 
## Coefficient(s):
## 
##            Estimate  Std. Error  t value  Pr(>|t|)    
## const.L   22.905069   47.818727   0.4790    0.6328    
## phiL.1     1.012612    0.050424  20.0821 < 2.2e-16 ***
## const.H -351.274980  251.367333  -1.3975    0.1650    
## phiH.1     1.048112    0.246488   4.2522  4.33e-05 ***
## phiH.2     0.188664    0.192645   0.9793    0.3295    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Threshold
## Variable: Z(t) = + (1) X(t) + (0) X(t-1)+ (0) X(t-2)
## 
## Value: 1193
# plot(modeloas4)
checkresiduals(ts(modeloas4.usd$residuals,start=c(2011,1),frequency = 12))
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

AIC(modeloas1.usd)
## [1] 1038.25
AIC(modeloas2.usd)
## [1] 1103.381
AIC(modeloas3.usd)
## [1] 1038.25
AIC(modeloas4.usd)
## [1] 1106.873
pronsetar1.usd<- predict(modeloas1.usd, n.ahead = 7)
pronsetar2.usd<- predict(modeloas2.usd, n.ahead = 7)
pronsetar3.usd<- predict(modeloas3.usd, n.ahead = 7)
pronsetar4.usd<- predict(modeloas4.usd, n.ahead = 7)

fit1.usd<-ts(modeloas1.usd$fitted.values,start =c(2011,1),frequency = 12)
fit2.usd<-ts(modeloas2.usd$fitted.values,start =c(2011,1),frequency = 12)
fit3.usd<-ts(modeloas3.usd$fitted.values,start =c(2011,1),frequency = 12)
fit4.usd<-ts(modeloas4.usd$fitted.values,start =c(2011,1),frequency = 12)

autoplot(sactnetusd_train)+
  autolayer(fit1.usd)+
  autolayer(fit2.usd)+
  autolayer(fit3.usd)+
  autolayer(fit4.usd)+
  theme_bw()

data.frame(
Modelo= c(
  "1) m = 3,mL = 3,mH = 1, d=1",
  "2) m = 3,mL = 2,mH = 3, d=2",
  "3) m = 3,mL = 3,mH = 2, d=1",
  "4) m = 3,mL = 1,mH = 2, d=2"
),
RMSE=c(
  Metrics::rmse(sactnetusd_test, pronsetar1.usd),
  Metrics::rmse(sactnetusd_test, pronsetar2.usd),
  Metrics::rmse(sactnetusd_test, pronsetar3.usd),
  Metrics::rmse(sactnetusd_test, pronsetar4.usd)))%>%
  arrange(RMSE)%>%
  knitr::kable()
Modelo RMSE
4) m = 3,mL = 1,mH = 2, d=2 269.2250
1) m = 3,mL = 3,mH = 1, d=1 380.1196
3) m = 3,mL = 3,mH = 2, d=1 380.1196
2) m = 3,mL = 2,mH = 3, d=2 389.9989 
autoplot(sactnetusd_test)+
  autolayer(pronsetar1.usd)+
  autolayer(pronsetar2.usd)+
  autolayer(pronsetar3.usd)+
  autolayer(pronsetar4.usd)+
  theme_bw()

Metricas Generales

Metrics::rmse(sactnetusd_test,(prontar2.usd))
Metrics::rmse(sactnetusd_test, (pronsetar4.usd))


autoplot(sactnetusd_test)+
  autolayer(prontar2)+
  autolayer(pronsetar3)+
  theme_bw()+